home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
dspice0s
/
keysrc.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-21
|
3KB
|
113 lines
/* keysrc.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Table of constant values */
static integer c__8 = 8;
static integer c__1 = 1;
/*< subroutine keysrc(keytab,lentab,tstwrd,index) >*/
/* Subroutine */ int keysrc_(keytab, lentab, tstwrd, index)
doublereal *keytab;
integer *lentab;
doublereal *tstwrd;
integer *index;
{
/* Initialized data */
static struct {
char e_1[8];
doublereal e_2;
} equiv_7 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
#define ablnk (*(doublereal *)&equiv_7)
static doublereal akey;
extern /* Subroutine */ int move_();
extern integer xxor_();
static integer i;
static doublereal achar;
static integer lenwrd;
static doublereal tstchr;
/* Parameter adjustments */
--keytab;
/* Function Body */
/*< implicit double precision (a-h,o-z) >*/
/*< double precision keytab >*/
/* this routine searches the keyword table 'keytab' for the possible
*/
/* entry 'tstwrd'. abbreviations are considered as matches. */
/*< dimension keytab(lentab) >*/
/*< integer xxor >*/
/*< data ablnk / 1h / >*/
/*< index=0 >*/
*index = 0;
/*< lenwrd=0 >*/
lenwrd = 0;
/*< achar=ablnk >*/
achar = ablnk;
/*< do 10 i=1,8 >*/
for (i = 1; i <= 8; ++i) {
/*< call move(achar,8,tstwrd,i,1) >*/
move_(&achar, &c__8, tstwrd, &i, &c__1);
/*< if (achar.eq.ablnk) go to 20 >*/
if (achar == ablnk) {
goto L20;
}
/*< lenwrd=lenwrd+1 >*/
++lenwrd;
/*< 10 continue >*/
/* L10: */
}
/*< 20 if (lenwrd.eq.0) go to 40 >*/
L20:
if (lenwrd == 0) {
goto L40;
}
/*< tstchr=ablnk >*/
tstchr = ablnk;
/*< call move(tstchr,8,tstwrd,1,1) >*/
move_(&tstchr, &c__8, tstwrd, &c__1, &c__1);
/*< 30 index=index+1 >*/
L30:
++(*index);
/*< if (index.gt.lentab) go to 40 >*/
if (*index > *lentab) {
goto L40;
}
/*< akey=ablnk >*/
akey = ablnk;
/*< call move(akey,1,keytab(index),1,lenwrd) >*/
move_(&akey, &c__1, &keytab[*index], &c__1, &lenwrd);
/*< if (xxor(akey,tstwrd).eq.0) go to 50 >*/
if (xxor_(&akey, tstwrd) == 0) {
goto L50;
}
/*< go to 30 >*/
goto L30;
/*< 40 index=-1 >*/
L40:
*index = -1;
/*< 50 return >*/
L50:
return 0;
/*< end >*/
} /* keysrc_ */
#undef ablnk